home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / textedit.swg / 0015_Pretty Good Text Editor.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-03-04  |  39.4 KB  |  1,354 lines
  1. {$B+}    {Boolean complete evaluation on}
  2. {$I+}    {I/O checking on} 
  3. {$N-}    {No numeric coprocessor} 
  4. {$R-}    {Range checking off} 
  5. {$S-}    {Stack checking on}
  6. {$V-}    {Var String checking off} 
  7.  
  8. Uses Crt,Dos,Printer;
  9.  
  10. Const 
  11.    MaxWidth      = 128; 
  12.    RtMrg         : Integer = 76; 
  13.    LeftM         : Integer = 1; 
  14.    Wrap          : Boolean = True; 
  15.    InSrt         : Boolean = True;
  16.    GoodColorCard : Boolean = True;     {set false for IBM CGA} 
  17.  
  18. Type 
  19.    Line       = String[MaxWidth]; 
  20.    LPtr       = ^LineRec; 
  21.    LineRec    = Record
  22.                   Last : LPtr; 
  23.                   Data : Line; 
  24.                   Next : LPtr; 
  25.                   Clr  : BYTE;
  26.                   End;
  27.    ScreenLine = String[80]; 
  28.    String80   = String[80]; 
  29.    Word       = String[24]; 
  30.  
  31. Var 
  32.    LWord                    : ScreenLine;     { left margin spacer } 
  33.    Find ,Repl , 
  34.    InPut,OutPut             : Word; 
  35.    Fore , Back, Attr        : Byte;           { text colors for Write} 
  36.    BaseOfScreen,Mode        : LongInt;        { used by FASTWRITE } 
  37.    WaitforRetrace           : Boolean;        {  "   "      "     } 
  38.    VidStatPort, VidModePort : LongInt;        {  "   "      "     } 
  39.    ModePortData             : Byte Absolute $40 : $65; {          } 
  40.    SearchString, 
  41.    Replacement              : ScreenLine; 
  42.    TextLine ,BlankLine      : ScreenLine; 
  43.    FileFound, 
  44.    Finished ,Changed        : Boolean; 
  45.    TabSet                   : Array [1..MaxWidth] Of Boolean;
  46.    TextFile                 : Text; 
  47.    WorkFile                 : Text; 
  48.    Ln,LastLn,NextLn, 
  49.    FirstLn,EndLn            : LPtr; 
  50.    MaxLines                 : Integer ; 
  51.    IBeg    , IEnd           : Integer ; 
  52.    BlockBeg, BlockEnd       : LPtr; 
  53.    I , J,                     {cursor position: i = line, j = column} 
  54.    Len,                       {length of current line} 
  55.    NLines,                    {length of file} 
  56.    NBl,                       {number of buffer lines} 
  57.    Top,                       {first line on screen} 
  58.    Offset, K, N             : Integer; 
  59.    Choice, Ch               : Char; 
  60.  
  61. (*-------------------------------------------------------------------*) 
  62.  
  63. Function YN: Boolean; 
  64. Begin 
  65.   Repeat 
  66.     Ch := ReadKey 
  67.   Until Ch In['y','Y','n','N']; 
  68.   If UpCase(Ch) = 'Y' Then 
  69.     YN := True 
  70.   Else YN := False; 
  71. End; 
  72.  
  73. Procedure Beep; 
  74. Begin 
  75.   Sound(800);
  76.   Delay(400); 
  77.   NoSound; 
  78.   Delay(1000); 
  79. End; 
  80.  
  81. Procedure Capitalize(var fname:word); 
  82. Begin 
  83.   For J := 1 To Length(FName) Do 
  84.     FName[J] := UpCase(FName[J]); 
  85. End; 
  86.  
  87. Procedure ReadFile; 
  88. Var  OvFlw     : Boolean; 
  89.      InputLine : String[255]; 
  90. Begin
  91.   If ParamStr(1) = '' Then 
  92.     Begin 
  93.       Write('File to edit: '); 
  94.       ReadLn(Input); 
  95.     End 
  96.   Else 
  97.     InPut := ParamStr(1); 
  98.   Capitalize(Input); 
  99.   New(Ln); 
  100.   Ln^.Data := ''; 
  101.   FirstLn  := Ln; 
  102.   EndLn    := Ln; 
  103.   Assign(WorkFile,Input); 
  104.   {$I-} ReSet(WorkFile); {I+} 
  105.   If IoResult = 0 Then
  106.     Begin 
  107.       OvFlw := False; 
  108.       MaxLines := MemAvail Div 12; 
  109.       If MaxLines < 0 Then 
  110.         MaxLines := 2730; 
  111.       NLines := 0; 
  112.       Write(' Reading file '); 
  113.       While Not (Eof(WorkFile) Or OvFlw) Do 
  114.         Begin 
  115.           ReadLn(WorkFile,InputLine); 
  116.           If Length(InputLine) > MaxWidth Then 
  117.             Begin 
  118.               WriteLn('File is too fat for this editor'); 
  119.               OvFlw := True; Delay(1000); 
  120.             End
  121.           Else 
  122.             Begin 
  123.               Ln^.Data := InputLine; 
  124.               LastLn   := Ln; 
  125.               New(Ln); 
  126.               Ln^.data     := ''; 
  127.               Ln^.last     := LastLn; 
  128.               LastLn^.Next := Ln; 
  129.               NLines       := NLines + 1; 
  130.               If NLines > MaxLines Then 
  131.                 Begin 
  132.                   WriteLn('File is too long. Not enough memory'); 
  133.                   OvFlw := True; Delay(1000); 
  134.                 End; 
  135.             End; 
  136.         End;       {not EOF} 
  137.      EndLn := Ln; 
  138.      If Not OvFlw Then 
  139.        FileFound := True; 
  140.     End   {IOresult = 0} 
  141.   Else 
  142.     Begin 
  143.       Write('Can''t find this file. Is this a new file?'); 
  144.       If YN Then 
  145.         Begin 
  146.           FileFound := True; 
  147.           NLines := 1; 
  148.           New(Ln); 
  149.           Ln^.Data      := ''; 
  150.           FirstLn^.Next := Ln; 
  151.           Ln^.Last      := FirstLn; 
  152.           EndLn         := Ln; 
  153.         End 
  154.       Else 
  155.         FileFound := False; 
  156.     End; 
  157.   Close(WorkFile); 
  158. End; 
  159.  
  160. Procedure WriteFile;     { save changes to file } 
  161. Begin 
  162.   GotoXY(1,1); For J := 1 To 45 Do Write(' '); 
  163.   GotoXY(1,1); Write('Text was changed. Save? '); 
  164.   If YN Then 
  165.     Begin 
  166.       Write('as: '); ReadLn(OutPut); 
  167.       If OutPut = '' Then 
  168.         OutPut := Input; 
  169.       Capitalize(OutPut); 
  170.       GotoXY(40,1); WriteLn('    Writing to disk as ',OutPut); 
  171.       Assign(WorkFile,OutPut); 
  172.       ReWrite(WorkFile); 
  173.       Ln := EndLn^.Next; 
  174.       Repeat 
  175.         WriteLn(WorkFile,Ln^.Data); 
  176.         Ln := Ln^.Next 
  177.       Until Ln = EndLn; 
  178.       Close(WorkFile); 
  179.    End; 
  180. End; 
  181.  
  182. {------------------------- FastWrite Routines -------------------------} 
  183.  
  184. Function Attribute(Foreground, Background : Byte) : Byte; 
  185.   {-Translates foreground and background colors into video attributes. 
  186.     "And 127" masks out the blink bit. Add 128 to the result to set it.} 
  187. Begin 
  188.    Attribute := ((Background Shl 4) + Foreground) And 127; 
  189. End; 
  190.  
  191. Function EgaInstalled : Boolean; 
  192.   {-Test for presence of the EGA. I have little idea how this works, but 
  193.     it does.} 
  194. Begin 
  195. Inline( 
  196.   $B8/$00/$12      {      MOV AX,$1200} 
  197.   /$BB/$10/$00     {      MOV BX,$10} 
  198.   /$B9/$FF/$FF     {      MOV CX,$FFFF} 
  199.   /$CD/$10         {      INT $10} 
  200.   /$31/$C0         {      XOR AX,AX} 
  201.   /$81/$F9/$FF/$FF {      CMP CX,$FFFF} 
  202.   /$74/$01         {      JE DONE} 
  203.   /$40             {      INC AX} 
  204.   /$88/$46/$04     {DONE: MOV [BP+$04],AL} 
  205. ); 
  206. End; 
  207.  
  208. Procedure GetVideoMode; 
  209.   {-Video mode of 7 indicates mono display; all other modes are for color 
  210.     displays. This routine MUST be called before any of the screen writing 
  211.     routines are used!} 
  212. Var 
  213.   Mode : Integer; 
  214.   Vid  : Integer Absolute $40 : $63; 
  215. Begin 
  216.      Inline( 
  217.        $B4/$0F        {MOV AH,$F} 
  218.        /$CD/$10       {INT $10} 
  219.        /$30/$E4       {XOR AH,AH} 
  220.        /$89/$46/<Mode {MOV [BP+<Mode],AX} 
  221.      ); 
  222.      If Mode = 6 Then Mode := 7; 
  223.      If Mode = 7 Then BaseOfScreen := $B000  { Mono } 
  224.                  Else BaseOfScreen := $B800; { Color } 
  225.      VidStatPort    := Vid + 6;   {video status port for either card} 
  226.      VidModePort    := Vid + 4;   {video mode port for either card} 
  227.      WaitForRetrace := (BaseOfScreen = $B800) And Not EgaInstalled; 
  228.      { *VERY IMPORTANT*  WaitForRetrace MUST be false if BaseOfScreen = $B000. } 
  229. End; 
  230.  
  231. Procedure VideoOff; 
  232. {-avoid snow writing full screen to c/g card} 
  233. Begin 
  234.   {clear video enable bit} 
  235.   Port[VidModePort] := ModePortData And 247; 
  236. End; 
  237.  
  238. Procedure VideoOn; 
  239. {-reenable video} 
  240. Begin 
  241.   {set video enable bit} 
  242.   Port[VidModePort] := ModePortData Or 8; 
  243. End; 
  244.  
  245. Procedure FastWrite( St : String80; Row, Col, Attr : Byte ); 
  246.   {-Write St directly to video memory, without snow.} 
  247. Begin 
  248. Inline( 
  249.   $1E                    {         PUSH DS                  ;Save DS} 
  250.   /$31/$C0               {         XOR AX,AX                ;AX = 0} 
  251.   /$88/$C1               {         MOV CL,AL                ;CL = 0} 
  252.   /$8A/$AE/>Row          {         MOV CH,[BP+>Row]         ;CX = Row * 256} 
  253.   /$FE/$CD               {         DEC CH                   ;Row to 0..24 range} 
  254.   /$D1/$E9               {         SHR CX,1                 ;CX = Row * 128} 
  255.   /$89/$CF               {         MOV DI,CX                ;Store in DI} 
  256.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 64} 
  257.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 32} 
  258.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160)} 
  259.   /$8B/$8E/>Col          {         MOV CX,[BP+>Col]         ;CX = Column} 
  260.   /$49                   {         DEC CX                   ;Col to 0..79 range} 
  261.   /$D1/$E1               {         SHL CX,1                 ;Account for attribute bytes} 
  262.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160) + (Col * 2)} 
  263.   /$8E/$06/>BaseOfScreen {         MOV ES,[>BaseOfScreen]   ;ES:DI points to Base:Row,Col} 
  264.   /$8A/$0E/>WaitForRetrace{        MOV CL,[>WaitForRetrace] ;Grab this before changing DS} 
  265.   /$8C/$D2               {         MOV DX,SS                ;Move SS...} 
  266.   /$8E/$DA               {         MOV DS,DX                ; into DS} 
  267.   /$8D/$B6/>St           {         LEA SI,[BP+>St]          ;DS:SI points to St[0]} 
  268.   /$FC                   {         CLD                      ;Set direction to forward} 
  269.   /$AC                   {         LODSB                    ;AX = Length(St); DS:SI -> St[1]} 
  270.   /$91                   {         XCHG AX,CX               ;CX = Length; AL = Wait} 
  271.   /$E3/$29               {         JCXZ Exit                ;If string empty, Exit} 
  272.   /$8A/$A6/>Attr         {         MOV AH,[BP+>Attr]        ;AH = Attribute} 
  273.   /$D0/$D8               {         RCR AL,1                 ;If WaitForRetrace is False...} 
  274.   /$73/$1D               {         JNC NoWait               ; use NoWait routine} 
  275.   /$BA/$DA/$03           {         MOV DX,$03DA             ;Point DX to CGA status port} 
  276.   /$AC                   {Next:    LODSB                    ;Load next character into AL} 
  277.                          {                                  ; AH already has Attr} 
  278.   /$89/$C3               {         MOV BX,AX                ;Store video word in BX} 
  279.   /$FA                   {         CLI                      ;No interrupts now} 
  280.   /$EC                   {WaitNoH: IN AL,DX                 ;Get 6845 status} 
  281.   /$A8/$08               {         TEST AL,8                ;Check for vertical retrace} 
  282.   /$75/$09               {         JNZ Store                ; In progress? go} 
  283.   /$D0/$D8               {         RCR AL,1                 ;Else, wait for end of} 
  284.   /$72/$F7               {         JC WaitNoH               ; horizontal retrace} 
  285.   /$EC                   {WaitH:   IN AL,DX                 ;Get 6845 status again} 
  286.   /$D0/$D8               {         RCR AL,1                 ;Wait for horizontal} 
  287.   /$73/$FB               {         JNC WaitH                ; retrace} 
  288.   /$89/$D8               {Store:   MOV AX,BX                ;Move word back to AX...} 
  289.   /$AB                   {         STOSW                    ; and then to screen} 
  290.   /$FB                   {         STI                      ;Allow interrupts} 
  291.   /$E2/$E8               {         LOOP Next                ;Get next character} 
  292.   /$EB/$04               {         JMP SHORT Exit           ;Done} 
  293.   /$AC                   {NoWait:  LODSB                    ;Load next character into AL} 
  294.                          {                                  ; AH already has Attr} 
  295.   /$AB                   {         STOSW                    ;Move video word into place} 
  296.   /$E2/$FC               {         LOOP NoWait              ;Get next character} 
  297.   /$1F                   {Exit:    POP DS                   ;Restore DS} 
  298. ); 
  299. End; 
  300.  
  301. Procedure FastWriteV( Var St; Row, Col, Attr : Byte ); 
  302.   {-Works with string variables ONLY. (I made St an untyped parameter 
  303.     only to make this easier to use when type checking is on.) This is 
  304.     just FastWrite optimized for use with string Variables, for times 
  305.     when speed really matters.} 
  306. Begin 
  307. Inline( 
  308.   $1E                    {         PUSH DS} 
  309.   /$31/$C0               {         XOR AX,AX} 
  310.   /$88/$C1               {         MOV CL,AL} 
  311.   /$8A/$6E/<Row          {         MOV CH,[BP+<Row]} 
  312.   /$FE/$CD               {         DEC CH} 
  313.   /$D1/$E9               {         SHR CX,1} 
  314.   /$89/$CF               {         MOV DI,CX} 
  315.   /$D1/$EF               {         SHR DI,1} 
  316.   /$D1/$EF               {         SHR DI,1} 
  317.   /$01/$CF               {         ADD DI,CX} 
  318.   /$8B/$4E/<Col          {         MOV CX,[BP+<Col]} 
  319.   /$49                   {         DEC CX} 
  320.   /$D1/$E1               {         SHL CX,1} 
  321.   /$01/$CF               {         ADD DI,CX} 
  322.   /$8E/$06/>BaseOfScreen {         MOV ES,[>BaseOfScreen]} 
  323.   /$8A/$0E/>WaitForRetrace{        MOV CL,[>WaitForRetrace]} 
  324.   /$C5/$76/<St           {         LDS SI,[BP+<St]          ;DS:SI points to St[0]} 
  325.   /$FC                   {         CLD} 
  326.   /$AC                   {         LODSB} 
  327.   /$91                   {         XCHG AX,CX} 
  328.   /$E3/$28               {         JCXZ Exit} 
  329.   /$8A/$66/<Attr         {         MOV AH,[BP+<Attr]} 
  330.   /$D0/$D8               {         RCR AL,1} 
  331.   /$73/$1D               {         JNC NoWait} 
  332.   /$BA/$DA/$03           {         MOV DX,$03DA} 
  333.   /$AC                   {Next:    LODSB} 
  334.   /$89/$C3               {         MOV BX,AX} 
  335.   /$FA                   {         CLI} 
  336.   /$EC                   {WaitNoH: IN AL,DX} 
  337.   /$A8/$08               {         TEST AL,8} 
  338.   /$75/$09               {         JNZ Store} 
  339.   /$D0/$D8               {         RCR AL,1} 
  340.   /$72/$F7               {         JC WaitNoH} 
  341.   /$EC                   {WaitH:   IN AL,DX} 
  342.   /$D0/$D8               {         RCR AL,1} 
  343.   /$73/$FB               {         JNC WaitH} 
  344.   /$89/$D8               {Store:   MOV AX,BX} 
  345.   /$AB                   {         STOSW} 
  346.   /$FB                   {         STI} 
  347.   /$E2/$E8               {         LOOP Next} 
  348.   /$EB/$04               {         JMP SHORT Exit} 
  349.   /$AC                   {NoWait:  LODSB} 
  350.   /$AB                   {         STOSW} 
  351.   /$E2/$FC               {         LOOP NoWait} 
  352.   /$1F                   {Exit:    POP DS} 
  353. ); 
  354. End; 
  355.  
  356. {------------------------- FastWrite Routines -------------------------} 
  357.  
  358. Procedure RulerLine; 
  359. Var 
  360.   C , J : Byte; 
  361. Begin 
  362.   TextLine := BlankLine; 
  363.   For J := 1 To 79 Do 
  364.     Begin 
  365.       If J Mod 5 = 0 Then 
  366.         TextLine[J] := '+' 
  367.       Else 
  368.         TextLine[J] := '-'; 
  369.       C := 48 + ((J + Offset) Div 10) Mod 10 ; 
  370.       If J Mod 10 = 0 Then 
  371.         TextLine[J] := Chr(C); 
  372.     End; 
  373.   FastWriteV(TextLine,2,1, Attr); 
  374.   If (Wrap) Then   { put margin markers on ruler } 
  375.     Begin 
  376.       Textcolor(14); 
  377.       TextBackGround(Green); 
  378.       if LeftM >= Offset Then 
  379.         Begin 
  380.           GotoXY(LeftM - Offset + 1, 2); 
  381.           Write('|'); 
  382.         End; 
  383.       If RtMrg >= Offset Then 
  384.         Begin 
  385.           GotoXY(RtMrg - Offset + 1, 2); 
  386.           Write('|'); 
  387.         End; 
  388.       TextColor( Fore ); 
  389.       TextBackGround( Back ); 
  390.    End; 
  391. End; 
  392.  
  393. Procedure StatusLine; 
  394. Begin 
  395.   Textline := BlankLine; 
  396.   Insert(' Line:      Column:',TextLine,1); 
  397.   If Insrt Then Insert('Insert ',TextLine,26) 
  398.     Else Insert('OverWrite ',TextLine,25); 
  399.   If Wrap  Then Insert(' WordWrap',TextLine,35) 
  400.     Else Insert('  NoWrap   ',TextLine,35); 
  401.   Insert(' Workfile:',TextLine,47); 
  402.   Insert(Input,TextLine,58); 
  403.   FastWriteV(TextLine,1,1,Attr); 
  404.   RulerLine; 
  405. End; 
  406.  
  407. Procedure WriteLine(Row,Attr:Byte);    { direct write to screen } 
  408. Var Len        : Byte;                 { writes blanks where there is no text} 
  409.     Contents   : ScreenLine; 
  410. Begin 
  411.   TextLine := BlankLine; 
  412.   Contents := Copy(Ln^.Data,Offset,80); 
  413.   Len      := Ord(Contents[0]); 
  414.   Insert(Contents,TextLine,1); 
  415.   If Len = 80 Then TextLine[80] := '+' 
  416.     Else If Len > 0 Then TextLine[80] := '<'; 
  417.   FastWriteV(TextLine,Row,1,Attr); 
  418. End; 
  419.  
  420. Procedure Screen;     { rewrites the bottom 23 lines } 
  421. Var Row   : Byte; 
  422.     TopLn : LPtr; 
  423. Begin                 { makes sure i and ln are in register } 
  424.   Ln := EndLn^.Next; 
  425.   If Top > 1 Then 
  426.    For K := 2 To Top Do 
  427.     Ln := Ln^.Next; 
  428.   TopLn := Ln; 
  429.   For Row := 3 to 25 do 
  430.    Begin 
  431.     WriteLine(Row,Attr); 
  432.     If Ln <> EndLn Then 
  433.      Ln := Ln^.Next; 
  434.    End; 
  435.   Ln  := TopLn; 
  436.   Row := I - Top; 
  437.   While Row > 0 do 
  438.    Begin 
  439.     Ln  := Ln^.Next; 
  440.     Row := Row - 1; 
  441.    End; 
  442. End; 
  443.  
  444. Procedure Help; 
  445. Begin 
  446.   Window(1, 1, 80, 25); 
  447.   ClrScr;
  448.   GetVideoMode;
  449.   FastWrite('╔══════════════════════════════════════════════════════════════════════════════╗', 1, 1, Attr );
  450.   FastWrite('║                    Window Editor -- by GDSOFT                                ║', 2, 1, Attr );
  451.   FastWrite('║ ┌───────────────────────┐ ┌───────────────────────┐ ┌──────────────────────┐ ║', 3, 1, Attr );
  452.   FastWrite('║ │  ^X      line up      │ │  ^S     column left   │ │  Alt-A   Ascii       │ ║', 4, 1, Attr );
  453.   FastWrite('║ │  ^E      line down    │ │  ^D     column right  │ │  Alt-B   Back Color  │ ║', 5, 1, Attr );
  454.   FastWrite('║ │  ^C      page up      │ │  ^PgUp  file home     │ │  Alt-C   Copy Block  │ ║', 6, 1, Attr );
  455.   FastWrite('║ │  ^R      page down    │ │  ^PgDn  file end      │ │  Alt-D   Del  Block  │ ║', 7, 1, Attr );
  456.   FastWrite('║ │  ^K      quit         │ │  ^N     insert line   │ │  Alt-F   Fore Color  │ ║', 8, 1, Attr );
  457.   FastWrite('║ │  ^P      set margins  │ │  ^Y     delete line   │ │  Alt-G   Goto Block  │ ║', 9, 1, Attr );
  458.   FastWrite('║ │  ^BkSp   delete word  │ │  BkSp   delete char   │ │  Alt-M   Move Block  │ ║',10, 1, Attr );
  459.   FastWrite('║ │  ^V      toggle ins   │ │  Ins    toggle insert │ │  Alt-N   Clr  Marks  │ ║',11, 1, Attr );
  460.   FastWrite('║ │  ^W      window dn    │ │                       │ │  Alt-S   Beg  Block  │ ║',12, 1, Attr );
  461.   FastWrite('║ │  ^Z      window up    │ │  Del    delete char   │ │  Alt-T   End  Block  │ ║',13, 1, Attr );
  462.   FastWrite('║ │  ^Home   erase bol    │ │  Home   beg of line   │ │                      │ ║',14, 1, Attr );
  463.   FastWrite('║ │  ^End    erase eol    │ │  End    end of line   │ │  SPELLING CHECK      │ ║',15, 1, Attr );
  464.   FastWrite('║ │  ^F      next word    │ │  Tab    next tab stop │ │  Alt-0   Document    │ ║',16, 1, Attr );
  465.   FastWrite('║ │  ^A      prev word    │ │  BTab   last tab stop │ │  Alt-1   Word        │ ║',17, 1, Attr );
  466.   FastWrite('║ │  F1      help         │ │  F6     replace       │ │                      │ ║',18, 1, Attr );
  467.   FastWrite('║ │  F2      clear marks  │ │  F7     page up       │ │                      │ ║',19, 1, Attr );
  468.   FastWrite('║ │  F3      quit         │ │  F8     page down     │ │                      │ ║',20, 1, Attr );
  469.   FastWrite('║ │  F4      set margins  │ │  F9     prev word     │ │                      │ ║',21, 1, Attr );
  470.   FastWrite('║ │  F5      search       │ │  F10    next word     │ │                      │ ║',22, 1, Attr );
  471.   FastWrite('║ └───────────────────────┘ └───────────────────────┘ └──────────────────────┘ ║',23, 1, Attr );
  472.   FastWrite('║                  Press any key to return to your editing.....                ║',24, 1, Attr );
  473.   FastWrite('╚══════════════════════════════════════════════════════════════════════════════╝',25, 1, Attr );
  474.   Repeat
  475.   Until KeyPressed;
  476.   Ch := ReadKey;
  477.   StatusLine;
  478.   Screen; 
  479. End; 
  480.  
  481. Procedure PageUp; 
  482. Begin 
  483.   If Top > 22 Then Begin 
  484.     Top := Top - 22; I := I - 22; End 
  485.   Else Begin 
  486.     I := I - Top + 1; Top := 1; End; 
  487.   Screen; 
  488. End; 
  489.  
  490. Procedure PageDown; 
  491. begin 
  492.   If Top <= (NLines - 44) Then 
  493.    Begin 
  494.     Top := Top + 22; 
  495.     I := I + 22; 
  496.    End 
  497.   Else If NLines > 22 Then 
  498.    Begin 
  499.     I := I - Top + NLines - 22; 
  500.     Top := NLines - 22; 
  501.    End; 
  502.   Screen; 
  503. End; 
  504.  
  505. Procedure Cursor;       { make sure the cursor is visible on the screen } 
  506. Var ii,jj,chgd : Word; 
  507.     Shifted    : Boolean; 
  508. Begin 
  509.   Shifted := False; 
  510.   If I < 1 Then 
  511.     Begin 
  512.       I  := 1; 
  513.       Ln := EndLn^.Next; 
  514.     End; 
  515.   If I > NLines Then 
  516.     Begin 
  517.       I  := NLines; 
  518.       Ln := EndLn^.Last; 
  519.     End; 
  520.   If J < 1 Then 
  521.     J := 1; 
  522.   If J > MaxWidth Then 
  523.     J := MaxWidth; 
  524.   Len := Ord(Ln^.Data[0]); 
  525.   If ( J > Offset + 77 ) Then 
  526.     Begin 
  527.       Offset  := 10 * ( J Div 10 ) - 59; 
  528.       Shifted := True; 
  529.     End; 
  530.   If J < Offset Then 
  531.     Begin 
  532.       Offset  := 10 * ( ( J - 10 ) Div 10 ) + 1; 
  533.       Shifted := True; 
  534.     End; 
  535.   If I < Top Then 
  536.     Begin 
  537.       Top     := I; 
  538.       Shifted := True; 
  539.     End; 
  540.   If I > Top + 22 Then 
  541.     Begin 
  542.       Top     := I - 22; 
  543.       Shifted := True; 
  544.     End; 
  545.   If Shifted Then 
  546.     Begin 
  547.       RulerLine; 
  548.       Screen; 
  549.     End; 
  550.   Str(i:4,ii); 
  551.   Str(j:3,jj); 
  552.   If Changed Then Chgd := ' * ' 
  553.     Else Chgd := '   '; 
  554.   FastWriteV(ii,1,7,Attr);    GetVideoMode; 
  555.   FastWriteV(jj,1,20,Attr);   GetVideoMode; 
  556.   FastWriteV(Chgd,1,76,Attr); GetVideoMode; 
  557.   GotoXY( J - Offset + 1, i - top + 3); 
  558. End; 
  559.  
  560. Procedure CursorLeft; 
  561. Begin 
  562.   J := J - 1; 
  563.   If J < 1 Then 
  564.     Begin 
  565.       I := I - 1; 
  566.       If I < 1 Then 
  567.         Begin 
  568.           I  := 1; 
  569.           J  := 1; 
  570.           Ln := EndLn^.Next ; 
  571.           Exit; 
  572.         End; 
  573.       J := Length(Ln^.Last^.Data) + 1 ; 
  574.       Ln := Ln^.Last ; 
  575.    End 
  576. End; 
  577.  
  578. Procedure CursorRight; 
  579. Begin 
  580.   j := j + 1; 
  581.   if j > MaxWidth then 
  582.     Begin 
  583.       i := i + 1; 
  584.       If I > NLines then 
  585.         Begin 
  586.           I  := NLines; 
  587.           Ln := EndLn^.Last ; 
  588.         End 
  589.       Else If I < NLines Then 
  590.         Ln := Ln^.Next ; 
  591.       J := 1; 
  592.     End; 
  593. End; 
  594.  
  595. Procedure ParaForm;  { set margins, wordwrap on/off } 
  596. Begin 
  597.   GotoXY(1,1); ClrEol; 
  598.   Write('WordWrap? '); 
  599.   If YN Then 
  600.     Wrap := True 
  601.   Else 
  602.     Begin 
  603.       Wrap  := False; 
  604.       LeftM := 1; 
  605.       LWord := ''; 
  606.     End; 
  607.   If Wrap Then 
  608.     Begin 
  609.       GotoXY(15,1); Write('Left margin: '); 
  610.       ReadLn(LeftM); 
  611.       LWord := ''; 
  612.       While Length(LWord) < LeftM - 1 Do 
  613.         LWord := LWord + ' '; 
  614.       RulerLine; 
  615.       Repeat 
  616.         GotoXY(35,1); Write('Right margin: '); 
  617.         ReadLn(RtMrg); 
  618.       Until RtMrg > LeftM + 24; 
  619.     End; 
  620.   ClrScr; 
  621.   StatusLine; 
  622.   Screen; 
  623. End;    { ParaForm } 
  624.  
  625. Procedure InsertLn(contents:line);  {insert after current line} 
  626. Begin 
  627.   New(NextLn); 
  628.   NextLn^.Data := Contents; 
  629.   NextLn^.Last := Ln; 
  630.   NextLn^.Next := Ln^.Next; 
  631.   Ln^.Next^.Last := NextLn; 
  632.   Ln^.Next := NextLn; 
  633.   NLines   := NLines + 1; 
  634. End; 
  635.  
  636. Procedure CutLine;    { start new line after <CR> } 
  637. Var 
  638.   More : Line; 
  639. Begin 
  640.   More := Copy(Ln^.Data,J,Len-J+1); 
  641.   Delete(Ln^.Data,J,Len-J+1); 
  642.   InsertLn(LWord + More); 
  643.   i := i + 1; 
  644.   j := LeftM; 
  645.   Screen; 
  646. End; 
  647.  
  648. Procedure WordWrap; 
  649. Begin 
  650.   N := 0; 
  651.   Repeat 
  652.     J := J - 1; 
  653.     N := N + 1; 
  654.   Until (Ln^.Data[J] = ' ') Or (J = 1); 
  655.   J   := J + 1; 
  656.   Len := Len + 1; 
  657.   CutLine; 
  658.   J := LeftM + N - 1 ; 
  659. end; 
  660.  
  661. Procedure StackLine;   { put current line on top of previous line } 
  662. begin 
  663.   j := length(ln^.last^.data)+1; 
  664.   ln^.last^.data := ln^.last^.data + ln^.data; 
  665.   ln^.last^.next := ln^.next;     { isolate current line } 
  666.   ln^.next^.last := ln^.last; 
  667.   Dispose(Ln);                    { and zap it} 
  668.   I := I - 1; 
  669.   NLines := NLines - 1; 
  670.   Screen; 
  671. End; 
  672.  
  673. Procedure DeleteLine; 
  674. Begin 
  675.   Ln^.Last^.Next := Ln^.Next;     { isolate current line } 
  676.   Ln^.Next^.Last := Ln^.Last; 
  677.   Dispose(Ln);                    { and zap it} 
  678.   J  := 1 ;  I := I - 1; 
  679.   NLines  := NLines - 1; 
  680.   Changed := True; 
  681.   StatusLine; 
  682.   Screen; 
  683. End; 
  684.  
  685. Procedure DeleteEOL; 
  686. Begin 
  687.   If J < MaxWidth Then 
  688.     Begin 
  689.       Ln^.Data := Copy ( Ln^.Data, 1 , J - 1 ) ; 
  690.       Changed := True; 
  691.     End; 
  692.   If J > 1 Then 
  693.     J := J - 1; 
  694.   StatusLine ; 
  695.   Screen ; 
  696. End; 
  697.  
  698. Procedure DeleteBOL; 
  699. Begin 
  700.   If J > 1 Then 
  701.     Begin 
  702.       Ln^.Data := Copy ( BlankLine, 1, J ) + Copy ( Ln^.Data, J + 1 , MaxWidth ) ; 
  703.       Changed := True; 
  704.     End; 
  705.   If J < MaxWidth Then 
  706.     J := J + 1; 
  707.   StatusLine ; 
  708.   Screen ; 
  709. End; 
  710.  
  711. Procedure DeleteWord; 
  712. Var 
  713.   EndW : Byte; 
  714. Begin 
  715.   While (( Copy(Ln^.Data,J,1) <> ' ' ) And ( J > 0 )) Do 
  716.     J := J - 1 ; 
  717.   If J = 0 Then 
  718.     J := 1 ; 
  719.   EndW := J + 1; 
  720.   While (( Copy(Ln^.Data,EndW,1) <> ' ' ) And ( EndW < MaxWidth )) Do 
  721.     EndW := EndW + 1 ; 
  722.   If J = 1 Then 
  723.     Ln^.Data := Copy ( Ln^.Data , EndW + 1, MaxWidth ) 
  724.   Else 
  725.     Ln^.Data := Copy ( Ln^.Data, 1, J ) + Copy ( Ln^.Data , EndW + 1, MaxWidth ) ; 
  726.   Changed := True ; 
  727.   StatusLine ; 
  728.   Screen ; 
  729. End; 
  730.  
  731. Procedure PrevWord; 
  732. Begin 
  733. (* if i am in a word then skip to the space *) 
  734.   While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And 
  735.          (( i <> 1 ) Or ( j <> 1 )) Do 
  736.       CursorLeft; 
  737. (* find end of previous word *) 
  738.   While ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) )) And 
  739.          (( i <> 1 ) Or ( j <> 1 )) Do 
  740.       CursorLeft; 
  741. (* find start of previous word *) 
  742.   While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And 
  743.          (( i <> 1 ) Or ( j <> 1 )) do 
  744.       CursorLeft; 
  745.    CursorRight; 
  746. End; 
  747.  
  748. Procedure NextWord; 
  749. Begin 
  750. (* if i am in a word, then move to the whitespace *) 
  751.   while (not ((Ln^.Data[j] = ' ') or ( j >= length(Ln^.Data)))) and 
  752.         ( i < NLines ) do 
  753.     CursorRight; 
  754. (* skip over the space to the other word *) 
  755.   while ((Ln^.Data[j] = ' ') or ( j >= Length(Ln^.Data))) and 
  756.          ( i < NLines ) do 
  757.     CursorRight; 
  758. End; 
  759.  
  760. Procedure Tab; 
  761. Begin 
  762.   If J < MaxWidth Then 
  763.     Begin 
  764.       Repeat 
  765.         J := J + 1; 
  766.       Until ( TabSet [J]= True ) Or ( J = MaxWidth ); 
  767.     End; 
  768. End; 
  769.  
  770. Procedure BackTab; 
  771. Begin 
  772.   If J > 1 Then 
  773.     Begin 
  774.       Repeat 
  775.          J := J - 1; 
  776.       Until ( TabSet [J]= True ) Or ( J = 1 ); 
  777.   End; 
  778. End; 
  779.  
  780. Procedure Search; 
  781. var 
  782.   Temp              : ScreenLine; 
  783.   Pointer, Position : Integer; 
  784.   LocPtr , Location : Integer; 
  785.   TmpPtr            : LPtr; 
  786. Begin 
  787.    Window(1, 1, 80, 25); 
  788.    GotoXY(1, 1); ClrEol; 
  789.    Write('Search:     Enter string: <',SearchString,'> '); 
  790.    Temp := ''; 
  791.    ReadLn(Temp); 
  792.    If Temp <> '' Then 
  793.       SearchString := Temp; 
  794.    If Length( SearchString ) = 0 Then 
  795.      Begin 
  796.        StatusLine; 
  797.        Screen; 
  798.        Exit; 
  799.      End; 
  800.    GotoXY(1,1); ClrEol; 
  801.    Write('Searching...'); 
  802.    NextWord; 
  803.    TmpPtr := Ln; 
  804.    LocPtr := J; 
  805.    For Location := I + 1 To NLines Do 
  806.      begin 
  807.        (* look for matches on this line *) 
  808.        Pointer := Pos (SearchString, Copy(Ln^.Data,LocPtr,MaxWidth)); 
  809.        (* if there was a match then get ready to print it *) 
  810.        If (Pointer > 0) Then 
  811.          Begin 
  812.            I := Location - 1 ; 
  813.            J := Pointer; 
  814.            StatusLine; 
  815.            Screen; 
  816.            Exit; 
  817.          End 
  818.        Else If Location <> NLines Then 
  819.          Begin 
  820.            Ln := Ln^.Next ; 
  821.            LocPtr := 1 ; 
  822.          End 
  823.    End; 
  824.    Window(1, 1, 80, 25); 
  825.    GotoXY(1, 1); ClrEol; 
  826.    Write('Search string not found.  Press any key to exit...'); 
  827.    Repeat 
  828.    Until KeyPressed; 
  829.    Ch := ReadKey; 
  830.    Ln := TmpPtr ; 
  831.    StatusLine; 
  832.    Screen; 
  833. End; 
  834.  
  835. Procedure Replace; 
  836. Var 
  837.   Temp               : ScreenLine; 
  838.   Pointer , Position : Integer; 
  839.   Location, Len      : Integer; 
  840. Begin 
  841.   Window(1, 1, 80, 25); 
  842.   GotoXY(1, 1); ClrEol; 
  843.   Write('Replace:     Enter search string: <',SearchString,'> '); 
  844.   Temp := ''; 
  845.   ReadLn(Temp); 
  846.   If Temp <> '' Then 
  847.     SearchString := Temp; 
  848.   If Length(SearchString) = 0 Then 
  849.     Begin 
  850.       StatusLine; 
  851.       Screen; 
  852.       Exit; 
  853.     End; 
  854.   GotoXY(1, 1); ClrEol; 
  855.   Write('Replace:     Enter replacement string: <',replacement,'> '); 
  856.   Temp := ''; 
  857.   ReadLn(Temp); 
  858.   if Temp <> '' Then 
  859.     Replacement := Temp; 
  860.   Len := Length (Replacement); 
  861.   Ln  := EndLn^.Next ; 
  862.   I   := 1 ;  J := 1 ; 
  863.   GotoXY(1, 1);  ClrEol; 
  864.   Write('Searching...'); 
  865.   For Location := 1 to NLines Do 
  866.     Begin 
  867.       (* look for matches on this line *) 
  868.       Position := Pos (SearchString, Ln^.Data ); 
  869.       (* if there was a match then get ready to print it *) 
  870.       While (Position > 0) Do 
  871.         Begin 
  872.           I   := Location ; 
  873.           J   := Position ; 
  874.           If Location > 8 Then 
  875.             Top := Location - 8 
  876.           Else 
  877.             Top := 1 ; 
  878.           Screen ; 
  879.           TextColor( Back ); 
  880.           TextBackGround( Fore ); 
  881.           GotoXY( J - Offset + 1, I - Top + 3 ); 
  882.           Write ( SearchString ); 
  883.           TextColor( Fore ); 
  884.           TextBackGround( Back ); 
  885.           GotoXY(1, 1); ClrEol; 
  886.           Write('Replace (Y/N/ESC)? '); 
  887.           Ch := ReadKey; 
  888.           If Ord (Ch)= 27 Then 
  889.             Begin 
  890.               I  := 1; 
  891.               J  := 1; 
  892.               Ln := EndLn^.Next ; 
  893.               StatusLine; 
  894.               Screen; 
  895.               Exit; 
  896.             End; 
  897.           If Ch In ['y','Y'] Then 
  898.             Begin 
  899.               Ln^.Data := Copy (Ln^.Data, 1, Position - 1) + Replacement + 
  900.                               Copy (Ln^.Data, Position + Length (SearchString), MaxWidth); 
  901.               Position := Pos (SearchString, Copy (Ln^.Data, Position + Len + 1,MaxWidth)) ; 
  902.             End 
  903.           Else 
  904.             Position := Pos (SearchString, Copy (Ln^.Data, Position + Length(SearchString) + 1,MaxWidth)) ; 
  905.         End; 
  906.       Ln := Ln^.Next ; 
  907.       GotoXY(1, 1);  ClrEol; 
  908.       Write('Searching...'); 
  909.     End; 
  910.   Window(1, 1, 80, 25); 
  911.   GotoXY(1, 1); ClrEol; 
  912.   Write('End of replace.  Press any key to exit...'); 
  913.   Repeat 
  914.   Until KeyPressed; 
  915.   Ch := ReadKey; 
  916.   Ln := EndLn^.Next ; 
  917.   I  := 1 ; 
  918.   J  := 1 ; 
  919.   StatusLine; 
  920.   Screen; 
  921. End; 
  922.  
  923. Procedure ClearMarks ; 
  924. Begin 
  925.   IBeg := 0 ; 
  926.   IEnd := 0 ; 
  927.   BlockBeg := Nil ; 
  928.   BlockEnd := Nil ; 
  929. End; 
  930.  
  931. Procedure InsertMark( Mark : Char ); 
  932. Begin 
  933.   If Mark = 'B' Then 
  934.     Begin 
  935.       If BlockBeg = Nil Then 
  936.         Begin 
  937.           BlockBeg := Ln ; 
  938.           IBeg     := I  ; 
  939.         End 
  940.       Else  { BlockBeg Already Defined } 
  941.         Write(#7); 
  942.     End; 
  943.   If Mark = 'E' Then 
  944.     Begin 
  945.       If BlockEnd = Nil Then 
  946.         Begin 
  947.           BlockEnd := Ln ; 
  948.           IEnd     := I  ; 
  949.         End 
  950.       Else  { BlockEnd Already Defined } 
  951.         Write(#7); 
  952.     End; 
  953. End; 
  954.  
  955. Procedure GotoBlock ; 
  956. Begin 
  957.   If BlockBeg <> Nil Then 
  958.     Begin 
  959.       Ln  := BlockBeg ; 
  960.       I   := IBeg; 
  961.       J   := 1 ; 
  962.       If ( I >= 12 ) Then 
  963.         Top := I - 8; 
  964.       StatusLine ; 
  965.       Screen ; 
  966.     End; 
  967. End; 
  968.  
  969. Procedure DeleteBlock; 
  970. Var 
  971.   TPtr   : LPtr; 
  972. Begin 
  973.   If IEnd < IBeg Then 
  974.     Exit; 
  975.   Ln := BlockEnd ; 
  976.   I  := IEnd ; 
  977.   Repeat 
  978.     TPtr           := Ln^.Last;     { save location of previous line } 
  979.     Ln^.Last^.Next := Ln^.Next;     { isolate current line } 
  980.     Ln^.Next^.Last := Ln^.Last; 
  981.     Dispose(Ln);                    { and zap it} 
  982.     J  := 1 ;  I := I - 1; 
  983.     NLines  := NLines - 1; 
  984.     Ln      := TPtr; 
  985.   Until Ln = BlockBeg^.Last ; 
  986.   If I >= 12 Then 
  987.     Top := I - 8 
  988.   Else 
  989.     Top := 1 ; 
  990.   Changed := True; 
  991.   ClearMarks; 
  992.   StatusLine; 
  993.   Screen; 
  994. End; 
  995.  
  996. Procedure CopyBlock; 
  997. var 
  998.   TPtr : LPtr ; 
  999.   Size : Integer; 
  1000. Begin 
  1001.   If IEnd < IBeg then 
  1002.     Exit; 
  1003.   If (IBeg < I) And (I <= IEnd) Then 
  1004.     Exit; 
  1005.   Size := IEnd - IBeg - 1;  { exclude markers } 
  1006.   If Size = 0 Then 
  1007.     Exit; 
  1008.   If NLines + Size <= MaxLines Then 
  1009.     Begin 
  1010.       Repeat 
  1011.           InsertLn (BlockEnd^.Data) ; 
  1012.           BlockEnd := BlockEnd^.Last ; 
  1013.           NLines   := NLines + 1 ; 
  1014.       Until BlockEnd = BlockBeg^.Last ; 
  1015.     End 
  1016.   Else 
  1017.     Write(#7); 
  1018.   Changed := True; 
  1019.   ClearMarks; 
  1020.   StatusLine; 
  1021.   Screen; 
  1022. End; 
  1023.  
  1024. Procedure MoveBlock; 
  1025. Var 
  1026.   Size : Integer; 
  1027.   TPtr : LPtr; 
  1028. Begin 
  1029.   If IEnd < IBeg Then 
  1030.     Exit; 
  1031.   If (IBeg <= I) And (I <= IEnd + 1) Then 
  1032.     Exit; 
  1033.   Size := IEnd - IBeg + 1; 
  1034.   If NLines + Size <= MaxLines Then 
  1035.     Begin 
  1036.       TPtr := Ln^.Next ; 
  1037.       BlockBeg^.Last^.Next := BlockEnd^.Next ; 
  1038.       BlockEnd^.Next^.Last := BlockBeg^.Last ; 
  1039.       Ln^.Next   := BlockBeg ; 
  1040.       TPtr^.Last := BlockEnd ; 
  1041.       BlockBeg^.Last := Ln ; 
  1042.       BlockEnd^.Next := TPtr ; 
  1043.     End 
  1044.   Else 
  1045.     Write(#7); 
  1046.   Changed := True; 
  1047.   ClearMarks; 
  1048.   StatusLine; 
  1049.   Screen; 
  1050. End; 
  1051.  
  1052. Procedure WriteBlock ; 
  1053. Var 
  1054.   TPtr : LPtr ; 
  1055. Begin 
  1056.   If ((BlockBeg = Nil) Or (BlockEnd = Nil)) Then 
  1057.     Exit ; 
  1058.   If IBeg + 1 < IEnd Then 
  1059.     Begin 
  1060.       GotoXY(1,1); For J := 1 To 45 Do Write(' '); 
  1061.       GotoXY(1,1); Write('Write Block To Disk ? '); 
  1062.       If YN Then 
  1063.         Begin 
  1064.           Write('as: '); ReadLn(OutPut); 
  1065.           If OutPut = '' Then 
  1066.             OutPut := Input; 
  1067.           Capitalize(OutPut); 
  1068.           GotoXY(40,1); WriteLn('    Writing to disk as ',OutPut); 
  1069.           Assign(WorkFile,OutPut); 
  1070.           ReWrite(WorkFile); 
  1071.           TPtr := BlockBeg; 
  1072.           Repeat 
  1073.             WriteLn(WorkFile,TPtr^.Data); 
  1074.             TPtr := TPtr^.Next 
  1075.           Until TPtr = BlockEnd; 
  1076.           Close(WorkFile); 
  1077.        End; 
  1078.     End 
  1079.   Else 
  1080.     Write(#7); 
  1081.   StatusLine ; 
  1082.   Screen ; 
  1083. End; 
  1084.  
  1085. Procedure AddChar;       { keyboard entry } 
  1086. begin 
  1087.   Changed := True; 
  1088.   While J > Len + 1 Do 
  1089.     Begin 
  1090.       Ln^.Data := Ln^.Data + ' ' ; 
  1091.       Len := Len + 1 ; 
  1092.     End; 
  1093.   If J = Len + 1 Then 
  1094.     Ln^.Data := Ln^.Data + Ch 
  1095.   Else If InSrt Then 
  1096.     Insert(Ch,Ln^.Data,J) 
  1097.   Else 
  1098.     Ln^.Data[J] := Ch; 
  1099.   J := J + 1; 
  1100.   WriteLine( I - Top + 3,Attr); 
  1101.   If  (J > RtMrg + 2) And Wrap Then 
  1102.     WordWrap; 
  1103. End; 
  1104.  
  1105. Procedure Ascii; 
  1106. Var 
  1107.   AscNo, Repeats, R : Integer; 
  1108.   AsciiLine         : ScreenLine; 
  1109. Begin 
  1110.   AsciiLine := ''; 
  1111.   GotoXY( 1, 1); ClrEol; 
  1112.   Write('Enter ASCII code number: --- '); 
  1113.   GotoXY(26,1); 
  1114.   Readln(AscNo); 
  1115.   GotoXY(1,1); 
  1116.   Write('Enter number of repeats: --  '); 
  1117.   GotoXY(26,1); 
  1118.   ReadLn(Repeats); 
  1119.   If Not(Repeats In [1..79]) Then 
  1120.     Repeats := 1; 
  1121.   If (AscNo > 0) And (AscNo < 256) Then 
  1122.     Begin 
  1123.       For R := 1 To Repeats Do 
  1124.         Begin 
  1125.           Ch := Chr(AscNo); 
  1126.           AsciiLine := AsciiLine + Ch ; 
  1127.         End; 
  1128.     End; 
  1129.   While J > Length(Ln^.Data) + 1 Do 
  1130.     Begin 
  1131.       Ln^.Data := Ln^.Data + ' ' ; 
  1132.       Len := Len + 1 ; 
  1133.     End; 
  1134.   J := J - 1; 
  1135.   If J = Length(Ln^.Data) + 1 Then 
  1136.     Ln^.Data := Ln^.Data + AsciiLine 
  1137.   Else If InSrt Then 
  1138.     Insert(AsciiLine,Ln^.Data,J) 
  1139.   Else 
  1140.     Ln^.Data := Copy(Ln^.Data,1,J) + AsciiLine + Copy(Ln^.Data,J + Length(AsciiLine),128); 
  1141.   Changed    := True; 
  1142.   StatusLine; 
  1143.   Screen; 
  1144. End; 
  1145.  
  1146. Procedure Leave; 
  1147. Var 
  1148.   Trash : Char; 
  1149. Begin 
  1150.   VideoOff; 
  1151.   Repeat 
  1152.   Until KeyPressed; 
  1153.   Trash := ReadKey; 
  1154.   If (Trash = #0) And (KeyPressed) Then 
  1155.     Trash := ReadKey; 
  1156.   VideoOn; 
  1157. End; 
  1158.  
  1159. Procedure Colors; 
  1160. Begin 
  1161.   Case Ch Of 
  1162.      #48 : Back  := (Back + 1) Mod 8; 
  1163.      #33 : Fore  := (Fore + 1) Mod 16; 
  1164.   End; 
  1165.   Attr := Attribute( Fore, Back ); 
  1166.   StatusLine; 
  1167.   Screen; 
  1168. End; 
  1169.  
  1170. Procedure Command;
  1171. Begin
  1172.   If Ch = #0 Then
  1173.     If KeyPressed Then Ch := ReadKey; { keypad input }
  1174.   Case Ch Of
  1175. {alt 1}  'x' : Begin
  1176.                { do something useful here }
  1177.                End;
  1178. {alt A}  #30 : Ascii;
  1179. {alt B, alt F}  #48,#33 : If Mode <> 7 Then Colors;
  1180. {alt C}  #46 : CopyBlock;
  1181. {alt D}  #32 : DeleteBlock;
  1182. {alt G}  #34 : GotoBlock;
  1183. {alt H}  #35 : Help;
  1184. {alt K}  #37 : ;
  1185. {alt L}  #38 : Leave; 
  1186. {alt M}  #50 : MoveBlock; 
  1187. {alt N}  #49 : ClearMarks; 
  1188. {alt S}  #31 : InsertMark('B'); 
  1189. {alt T}  #20 : InsertMark('E'); 
  1190. {alt W}  #17 : WriteBlock; 
  1191. {alt X}  #45 : Finished := True; 
  1192. {tab}     #9 : Tab; 
  1193. {bktab}  #15 : BackTab; 
  1194. {F1}     #59 : Help; 
  1195. {F2}     #60 : ClearMarks; 
  1196. {F3}     #61 : Finished := True; 
  1197. {F4}     #62 : ParaForm ; 
  1198. {F5}     #63 : Search ; 
  1199. {F6}     #64 : Replace; 
  1200. {F7}     #65 : PageUp ; 
  1201. {F8}     #66 : PageDown; 
  1202. {F9}     #67 : PrevWord; 
  1203. {F10}    #68 : NextWord; 
  1204. {home}   #71 : J := LeftM;
  1205. {end }   #79 : J := Len + 1; 
  1206. {^home} #119 : DeleteBOL; 
  1207. {^end } #117 : DeleteEOL; 
  1208. {^A} #116,#1 : PrevWord; 
  1209. {^D} #77, #4 : J := J + 1; 
  1210. {^S} #75,#19 : If J > 1 Then 
  1211.                  J := J - 1; 
  1212. {^E} #72, #5 : If I > 1 Then 
  1213.                  Begin 
  1214.                    I := I - 1; 
  1215.                    Ln := Ln^.Last; 
  1216.                  End; 
  1217. {^F} #115,#6 : NextWord; 
  1218. {^X} #80,#24 : If I < NLines Then 
  1219.                  Begin 
  1220.                    I  := I + 1; 
  1221.                    Ln := Ln^.Next; 
  1222.                  End; 
  1223. {del}#83, #7 : Begin 
  1224.                  Delete(Ln^.Data,J,1);
  1225.                  WriteLine(I - Top + 3,Attr); 
  1226.                End; 
  1227. { <-- }   #8 : If J = 1 Then 
  1228.                  StackLine 
  1229.                Else 
  1230.                  Begin 
  1231.                    J := J - 1; 
  1232.                    Delete(Ln^.Data,J,1); 
  1233.                    Cursor; 
  1234.                    WriteLine(i - Top + 3,Attr); 
  1235.                  End; 
  1236. {^<--}  #127 : DeleteWord; 
  1237. {Enter}  #13 : Begin 
  1238.                  If InSrt Then 
  1239.                    Begin 
  1240.                      If J = Len Then 
  1241.                        J := J + 1; 
  1242.                      CutLine; 
  1243.                    End 
  1244.                  Else
  1245.                    Begin 
  1246.                      I := I + 1 ; 
  1247.                      J := 1 ; 
  1248.                      Ln^ := Ln^.Next^ 
  1249.                    End; 
  1250.                End; 
  1251. {^R} #73,#18 : PageUp; 
  1252. {^C} #81, #3 : PageDown; 
  1253. {^PgUp} #132 : Begin 
  1254.                  I   := 1; 
  1255.                  Top := 1; 
  1256.                  Ln  := FirstLn; 
  1257.                  Screen; 
  1258.                End; 
  1259. {^PgDn} #118 : Begin 
  1260.                  I   := NLines; 
  1261.                  Top := NLines - 22; 
  1262.                  Ln  := EndLn; 
  1263.                  Screen; 
  1264.                End;
  1265. {^Y}     #25 : DeleteLine; 
  1266. {^N}     #14 : Begin 
  1267.                  Ln := Ln^.Last; 
  1268.                  InsertLn(''); 
  1269.                  Screen; 
  1270.                End; 
  1271. {Ins}#22,#82 : Begin 
  1272.                  If InSrt Then 
  1273.                    InSrt := False 
  1274.                  Else 
  1275.                    InSrt := True; 
  1276.                  StatusLine; 
  1277.                End; 
  1278. {^P}     #16 : ParaForm; 
  1279. {^W}     #23 : If Top > 1 Then 
  1280.                  Begin 
  1281.                    Top := Top - 1;
  1282.                    I := I - 1;
  1283.                    Screen;
  1284.                  End;
  1285. {^Z}     #26 : If Top < NLines + 22 Then
  1286.                  Begin
  1287.                    Top := Top + 1;
  1288.                    I := I + 1;
  1289.                    Screen;
  1290.                  End;
  1291. {^K} #27,#11 : Finished := True;
  1292.           Else Begin
  1293.             GotoXY(1,1); WriteLn('****** COMMAND NOT RECOGNIZED ******                    ');
  1294.             Beep; StatusLine;
  1295.           End;
  1296.    End; {case}
  1297. End;
  1298.  
  1299. Begin {Main}
  1300.  
  1301.   CheckBreak  := TRUE;
  1302.   DirectVideo := TRUE;
  1303.  
  1304.   ClearMarks  ;
  1305.   GetVideoMode;
  1306.  
  1307.   IF BaseOfScreen = $B000 Then
  1308.      Begin
  1309.         Fore := White;
  1310.         Back := Black;
  1311.      End
  1312.   Else Begin
  1313.         Fore := White; { make these whatever you want }
  1314.         Back := Black;
  1315.        End;
  1316.  
  1317.   Attr  := Attribute( Fore, Back );
  1318.   TextColor( Fore );
  1319.   TextBackground( Back );
  1320.   ClrScr;
  1321.   BlankLine := '';
  1322.   For J := 1 To 80 Do
  1323.     BlankLine := BlankLine + ' ';
  1324.   For I := 1 To MaxWidth Do
  1325.     TabSet[I]:=( I Mod 8 ) = 1;
  1326.   FileFound := False;
  1327.   ReadFile;
  1328.   If FileFound Then Begin
  1329.     FirstLn^.Last := EndLn ;
  1330.     EndLn^.Next   := FirstLn ;    { close chain, endless loop }
  1331.     J    := 1;   I      := 1 ;
  1332.     Top  := 1;   Offset := 1 ;
  1333.     Find := '.'; Repl   := '';
  1334.     Nbl  := 0;   Lword  := '';
  1335.     SearchString := ''; Finished := False;
  1336.     Replacement  := ''; Changed  := False;
  1337.     ClrScr;
  1338.     StatusLine;
  1339.     Screen;
  1340.     Repeat
  1341.       Cursor;
  1342.       Ch := ReadKey;
  1343.       Case Ch Of
  1344.         #0..#31,#127 : Command;
  1345.                 Else   AddChar;
  1346.       End;
  1347.     Until Finished;
  1348.     If Changed Then WriteFile;
  1349.   End;  {FileFound}
  1350.  
  1351.   TextAttr := 7;
  1352.   ClrScr;
  1353. End. 
  1354.